ANÁLISE ESTATÍSTICA MULTIVARIADA

---

Análise de Agrupamentos (Cluster)

Segundo Mingoti (2005, p.155), “a Análise de Agrupamentos, também conhecida como Análise de Conglomerados, Classificação ou Cluster, tem como objetivo dividir os elementos da amostra, ou população, em grupos de forma que os elementos pertencentes a um mesmo grupo sejam similares entre si com respeito às variáveis (características) que neles foram medidas, e os elementos em grupos diferentes sejam heterogêneos em relação a estas mesmas características”.

Assim, a idéia básica é maximizar a homogeneidade dentro dos grupos ao mesmo tempo em que se maximiza a heterogeneidade entre os grupos. Para formar grupos de objetos tem-se que medir e comparar a semelhança entre eles. A medida de semelhança fica dificultada quando se considera várias variáveis (características).

No processo de agrupamento, primeiro o conjunto de dados será dividido em grupos com elementos parecidos entre si e diferentes dos outros grupos. Depois os grupos encontrados serão analisados até que efetivamente se encontre a existência de padrões entre eles.

Etapas da Análise de Agrupamento - Clustering

No caso univariado é possível que apenas uma análise visual ou gráfica dos dados seja suficiente para decidir sobre os agrupamentos de observaçoes. Contudo, isto não é muito mais difícil quando se tem um conjunto maior de variáveis. Para realizar as técnicas de cluster é necessário definir o conceito de distância.

Etapas da Análise de Cluster

1. Escolher um critério de parecença (similaridade ou dissimilaridade);

2. Formação dos grupos (escolher o algoritmo de agrupamento);

3. Definição de número de grupos: pode ser a posteriori, como resultado da Análise ou a priori, dado o conhecimento ou conveniência da Análise;

4. Validação do agrupamento: critério do pesquisador;

5. Interpretação e Análise: pode-se fazer estatística descritiva, diferença de médias, etc.

Medidas de Parecença

Valor numérico que quantifica o grau de semelhança entre um par de objetos. Pode ser de dois tipos: similaridade ou dissimilaridade. Para variáveis quantitativas, quando se buscas agrupar observações as distâncias são as mais usadas. São medidas de dissimilaridade entre objetos. O coeficiente de distância assume valor máximo para objetos totalmente diferentes e valor zero para dois objetos idênticos considerando todas as variáveis.

Em algumas aplicações deseja-se agrupar variáveis ao invés de observações. Neste caso, o coeficiente de correlação de Pearson é mais comumente utilizado. No caso de variáveis binárias, os dados são novamente rearranjados na forma de uma tabela de contigência, com as variáveis formando as categorias.

Os coeficientes de distância mais comuns têm as seguintes propriedades:

1. Mínimo Zero: Se \(A=B\), então \(D(A,B)=0\);

2. Positividade: Se \(A \neq B\), então \(D(A,B)>0\);

3. Simetria: \(D(A,B) = D(B,A)\)

4. Desigualdade triangular: \(D(A,B)+D(B,C) \geq D(A,C)\)

Em relação às distâncias sabe-se pelo Teorema de Pitágoras que \(c^2=a^2+b^2\), assim, \(c=\sqrt{a^2+b^2}\), que é a Distância Euclidiana entre dois pontos (A e B). Em termos de variáveis, tem-se:

\[ D_{AB}=\sqrt{(X_{2A}-X_{2B})^2+(X_{1B}-X_{1A})^2} \] matricialmente, a Distância Euclidiana é definida por \(D_{AB}=\sqrt{(X_a-X_b)'(X_a-X_b)}\) e possui as seguintes propriedades:

1. Base geométrica bem definida;

2. Invariante com relação à transformação de origem;

3. Invariante com relação à transformação ortogonal;

4. Não invariante com relação à transformação de escala;

5. Não invariante com relação à transformação não ortogonal.

A Distância Euclidiana Quadrática é dada por

\[ D_{AB}^2=\sum_{j=1}^p(x_{ja}-x_{jb})^2 \]

A Distância Euclidiana Ponderada é definida por

\[ D_{AB}=\sqrt{(X_a-X_b)'A(X_a-X_b)} \]

com A sendo uma matriz de ponderação (pesos diferentes de acordo com a variância das variáveis). Se \(A=I\), \(D_{AB}\) é a Distância Euclidiana. Se \(A=S^{-1}\), ou seja, inverso da matriz var-cov, tem-se a Distância de Mahalanobis.

Se \(A=diag(S_i^2)^{-1}\), em que \(S_i^2\) é a variância amostral da i-ésima variável aleatória, leva-se em consideração na ponderação apenas as diferenças de variâncias das variáveis.

Se \(A=diag(1/p)\) tem-se a Distância Euclidiana Média;

A Distância de Minkowsky é dada por

\[ D_{AB}=\Big [\sum_i^p w_i | X_{ia} - X_{ib}| ^\lambda \Big]^{\frac{1}{\lambda}} \]

onde \(w_i\) são pesos de ponderação para as variáveis. Se \(\lambda=2\), tem-se a Distância Euclidiana. Esta distância é menos afetada pela presença de valores discrepantes numa amostra do que a distância Euclidiana. Se \(\lambda=1\), tem-se a Distância city-block também conhecida como Manhattan.

Para observações representadas através de variáveis qualitativas, é necessária a criação de variáveis binárias, as quais assumem o valor 1 se uma característica de interesse está presente, e 0, caso contrário. Dessa forma, para um par de observações (i; k) medidos através de p variáveis binárias, considere a seguinte Tabela de Contigência:

		Observação k
		1	0	Total
Observação i	1	a	b	a+b
	0	c	d	c+d
	Total	a+c	b+d	p=a+b+c+d

com base nesta tabela é possível listar algumas medidas de similaridade e a idéia básica de cada uma delas.

\(\frac{a+d}{p}\)	Pesos iguais para pares 1-1 e 0-0
\(\frac{2(a+d)}{2(a+d)+b+c}\)	Peso em dobro para pares 1-1 e 0-0
\(\frac{a+d}{a+d+2(b+c)}\)	Peso em dobro para pares descasados
\(\frac{a}{p}\)	Sem pares 0-0 no numerador
\(\frac{a}{a+b+c}\)	Sem pares 0-0 no numerador e no denominador
\(\frac{2a}{2a+b+c}\)	Sem pares 0 - 0 no numerador e no denominador.
	Peso em dobro para pares 1 - 1.
\(\frac{a}{a+2(b+c)}\)	Sem pares 0 - 0 no numerador e no denominador.
	Peso em dobro para pares descasados.
\(\frac{a}{b+c}\)	Razão entre pares 1 - 1 e pares descasados.

Organiza-se a tabela de contingência e calcula-se o coeficiente de similaridade para cada par de observações. Os coeficientes são dispostos em uma matriz simétrica n x n denominada matriz de similaridade.

Técnicas para construção de Conglomerados (Clusters)

Para Mingoti (2005, p.164), “as técnicas de conglomerados ou clusters são frequentemente classificadas em dois tipos: técnicas hierárquicas e não hierárquicas, sendo que as hierárquicas são classificadas em aglomerativas e divisivas”.

Os Métodos hierárquicos aglomerativos partem do princípio de que no início do processo de agrupamento têm-se n conglomerados (cada elemento é um conglomerado). Em cada passo do algoritmo, os elementos vão sendo agrupados, formando novos conglomerados até o ponto em que todos os elementos estão num único grupo.

Em termos de variabilidade, no estágio inicial é a menor possível e no final, a máxima possível, pois todos os elementos estão agrupados em apenas 1 cluster. Se dois elementos aparecem juntos num mesmo grupo em algum estçgio do processo de agrupamento, permanecerão juntos até o final, ou seja, não podem mais ser separados.

Devido a esta propriedade, denominada hierarquia, se pode construiu o Dendograma. Dendograma é um gráfico em forma de árvore no qual a escala vertical indica o nível de similaridade (ou dissimilaridade). No eixo horizontal tem-se os elementos e no vertical a altura correspondente ao nível em que os elementos foram considerados semelhantes. Quanto maior a altura maior a variabilidade, ou seja, maior a heterogeneidade dos grupos a serem unidos.

A outra técnica de construção dos clusters é chamada de Método hierárquivo Divisivo, que se inicia com todos os objetos em um grupo; formam-se subgrupos desagregando os grupos formados até terminar com cada objeto formando um grupo.

Existem ainda os Métodos não hierárquicos, também denominados de métodos de partição. Inicia-se com um número pré definido de grupos e a cada passo procura-se realocar os objetos de maneira a encontrar a melhor partição, isto é, a que minimiza a variância dentro do grupo e maximiza a variância entre grupos. Os métodos não hierárquicos não geram dendrograma, são aplicados a casos (observações) e não a variáveis e são mais indicados para amostras grandes.

Métodos de agrupamento

1. Método de ligação simples: também denominado de vizinho mais próximo ou single linkage. A similaridade entre dois grupos é definida pelos elementos mais parecidos. É a distância entre os vizinhos mais próximos ou entre os elementos mais parecidos de cada conglomerado.

\[ D_{I,II} = min \quad ({d_{ij}, i \in I, j \in II}) \]

2. Método de ligação completa ou do vizinho mais distante: A similaridade entre dois grupos é definida pelos elementos que são “menos semelhantes” entre si. Em cada passo do algoritmo são combinados os elementos que apresentarem o menor valor máximo de distância.

\[ D_{I,II} = max \quad ({d_{ij}, i \in I, j \in II}) \]

3. Método da média das distâncias (average linkage): Considera a distância entre dois grupos como a média das distâncias entre todos os pares de elementos dos dois grupos que estão sendo comparados.

\[ D_{i,j}=\frac{\sum_{i=1}^{n_I} \sum_{j=1}^{n_{II}}d_{ij}}{n_I n_{II}} \]

4. Método dos centróides: A distância entre dois grupos é definida como sendo a distância entre os vetores de médias (centróides), dos grupos comparados. É a distância Euclidiana quadrática entre os vetores de médias amostrais.

\[ D_{AB}=(\bar X_a - \bar X_b)'(\bar X_a - \bar X_b) \]

22. Método de Ward: No processo aglomerativo a medida que se agrupa o nível de similaridade diminui. Em cada passo do agrupamento ocorre diminuição de variabilidade entre grupos e aumento dentro dos grupos. O método de Ward se baseia na mudança de variação que ocorre de um estágio para outro. Este método tende a formar grupos com maior homogeneidade interna. O método considera o aumento na soma de quadrados dos erros como critério para juntar dois grupos. Para um dado grupo g, a soma de quadrados dos erros, \(SQE_g\), é a soma dos desvios ao quadrado de cada item para a média do grupo (centróide).

Em um estágio com G grupos, define-se \(SQE\) como a soma \(SQE=SQE_1+SQE_2+SQE_3+ \dots SQE_G\). Quando se junta dois grupos, SQE aumenta. Em cada etapa, a união de todos os pares de grupos é analisada. Junta-se os dois grupos que resultam no menor aumento de \(SQE\)

Segundo Mingoti (2005), “os métodos de ligação simples, completa e da média podem ser utilizados tanto para variáveis quantitativas, quanto qualitativas, ao contrário dos métodos do centróide e de Ward que são apropriados apenas para variáveis quantitativas, já que têm como base a comparação de vetores de médias”.

Análise de Conglomerados (Clusters) no R - Método Hieráquico

#Direcionado o R para o Diretorio a ser trabalhado
setwd('/Users/jricardofl/Dropbox/tempecon/dados_gescilene')

#Lendo os dados no R
library(foreign)
library(car)
library(tidyverse)
#library(Rcmdr)
library(corrplot)
library(MVar.pt)
library(cluster)
library(clValid) # Avaliação dos grupos
library(e1071) # Fuzzy K-médias
library(factoextra) # Vizualização de grupos
library(gridExtra) # Ferramentas gráficas
library(ggforce) # Ferramentas gráficas

#Entrada de Dados
dados <- read.dta("dados_gesc.dta")
str(dados)

'data.frame':   85 obs. of  16 variables:
 $ x1 : num  60 56 56 61 47 65 50 60 78 68 ...
 $ x2 : num  1 2 2 3 3 3 4 3 2 3 ...
 $ x3 : num  140000 86100 47600 90000 205200 ...
 $ x4 : num  15714 10500 9000 16667 17333 ...
 $ x5 : num  17376 0 0 0 26064 ...
 $ x6 : num  4502 1350 2400 2202 3376 ...
 $ x7 : num  26400 21600 20400 18000 22800 21600 24000 13200 16800 21600 ...
 $ x8 : num  48878 25800 26080 22902 55204 ...
 $ x9 : num  2 0 0 0 3 0 2 0 2 0 ...
 $ x10: num  0.111 0 0 0.222 0.111 ...
 $ x11: num  0.143 0 0.143 0 0 ...
 $ x12: num  20 0 1 5 20 20 10 15 20 10 ...
 $ x13: num  2 0 1 2 2 2 2 1 1 1 ...
 $ x14: num  1 0 1 0 0 0 0 0 0 0 ...
 $ x15: num  0.26 0.12 0.09 0.06 0.06 ...
 $ x16: num  1 0 1 0 1 0 1 1 1 1 ...
 - attr(*, "datalabel")= chr ""
 - attr(*, "time.stamp")= chr ""
 - attr(*, "formats")= chr [1:16] "%9.0g" "%9.0g" "%9.0g" "%9.0g" ...
 - attr(*, "types")= int [1:16] 254 254 254 254 254 254 254 254 254 254 ...
 - attr(*, "val.labels")= chr [1:16] "" "" "" "" ...
 - attr(*, "var.labels")= chr [1:16] "" "" "" "" ...
 - attr(*, "version")= int -7

# Nomes das Variáveis utilizadas 
#x1 Idade
#x2 Escolaridade
#x3 Renda Bruta Total
#x4 Produtividade
#x5 Valor total anual  de mão de obra permanente
#x6 Valor Total com custo anual com insumos agrícolas nas ativ. Irrig. em 2014
#x7 Custo com energia eletrica e agua
#x8 Capital total empregado na ativ irrig em 2014
#x9 N total de empregados
#x10 Indice de introducao de inovacao (III)
#x11 Indice de Inovacoes realizadas (II)
#x12 Gastos para desenvolver as atividade de inovacao sobre faturamento de 2014
#x13 Quantidade de tecnologia agricola utilizada na atividade irrigada  
#x14 Dummy se a empresa realizou atividades de treinamento e capacitacao de recursos humanos entre 2010 a 2014
#x15 Indice de Fonte de Informacao
#x16 Dummy se empresa esteve envolvida em atividades cooperativas entre os anos de 2010 e 2014
#####################################################

#dados <- dados1 %>% select(-x14, -x16)
dados <- dados[,-c(14,16)]

#Se quiser padronizar os dados
dados.pad <-as.data.frame(scale(dados))

#Analise Fatorial
fatorial1 <- factanal(dados.pad, factors=4, rotation="none", na.action=na.omit)
fatorial2 <- factanal(dados.pad, factors=4, rotation="varimax", na.action=na.omit, scores = c("regression"))

#Analise de Cluster
# Função que obtém o WSS para o método hierárquico
# NÃO MUDAR!
get_wss <- function(d, cluster){
  d <- stats::as.dist(d)
  cn <- max(cluster)
  clusterf <- as.factor(cluster)
  clusterl <- levels(clusterf)
  cnn <- length(clusterl)
  
  if (cn != cnn) {
    warning("cluster renumbered because maximum != number of clusters")
    for (i in 1:cnn) cluster[clusterf == clusterl[i]] <- i
    cn <- cnn
  }
  cwn <- cn
  # Compute total within sum of square
  dmat <- as.matrix(d)
  within.cluster.ss <- 0
  for (i in 1:cn) {
    cluster.size <- sum(cluster == i)
    di <- as.dist(dmat[cluster == i, cluster == i])
    within.cluster.ss <- within.cluster.ss + sum(di^2)/cluster.size
  }
  within.cluster.ss
}

# Função que constrói o "gráfico do cotovelo" e aponta o K ótimo
# NÃO MUDAR!
elbow.plot <- function(x, kmax = 15, alg = "kmeans") {
  # alg = c("kmeans", "cmeans", "hclust")
  wss <- c()
  if (alg == "kmeans") {
    for (i in 1:kmax) {
      set.seed(13)
      tmp <- kmeans(x, i)
      # wss[i] <- get_wss(dist(x), tmp$cluster)
      wss[i] <- tmp$tot.withinss
    }
    tmp <- data.frame(k = 1:kmax, wss)
    max_k <- max(tmp$k)
    max_k_wss <- tmp$wss[which.max(tmp$k)]
    max_wss <- max(tmp$wss)
    max_wss_k <- tmp$k[which.max(tmp$wss)]
    max_df <- data.frame(x = c(max_wss_k, max_k), y = c(max_wss, max_k_wss))
    tmp_lm <- lm(max_df$y ~ max_df$x)
    d <- c()
    for(i in 1:kmax) {
      d <- c(d, abs(coef(tmp_lm)[2]*i - tmp$wss[i] + coef(tmp_lm)[1]) /
               sqrt(coef(tmp_lm)[2]^2 + 1^2))
    }
    tmp$d <- d
    ggplot(data = tmp, aes(k, wss)) +
      geom_line() +
      geom_segment(aes(x = k[1], y = wss[1],
                       xend = max(k), yend = wss[which.max(k)]),
                   linetype = "dashed") +
      geom_point(aes(size = (d == max(d)), color = (d == max(d))),
                 show.legend = FALSE) +
      scale_size_manual(values = c(2,5)) +
      scale_color_manual(values = c("black", "red")) +
      labs(x = "Number of clusters",
           y = "Total within-cluster sum of squares",
           title = "Elbow plot for the K-means method") +
      theme_bw()
  }
  else if (alg == "cmeans") {
    for (i in 1:kmax) {
      if (i == 1) {
        wss[i] <- get_wss(dist(x), rep(1, nrow(x)))
      }
      else {
        set.seed(13)
        tmp <- cmeans(x, i)
        wss[i] <- get_wss(dist(x), tmp$cluster)
        # wss[i] <- tmp$sumsqrs$tot.within.ss
      }
    }
    tmp <- data.frame(k = 1:kmax, wss)
    max_k <- max(tmp$k)
    max_k_wss <- tmp$wss[which.max(tmp$k)]
    max_wss <- max(tmp$wss)
    max_wss_k <- tmp$k[which.max(tmp$wss)]
    max_df <- data.frame(x = c(max_wss_k, max_k), y = c(max_wss, max_k_wss))
    tmp_lm <- lm(max_df$y ~ max_df$x)
    d <- c()
    for(i in 1:kmax) {
      d <- c(d, abs(coef(tmp_lm)[2]*i - tmp$wss[i] + coef(tmp_lm)[1]) /
               sqrt(coef(tmp_lm)[2]^2 + 1^2))
    }
    tmp$d <- d
    ggplot(data = tmp, aes(k, wss)) +
      geom_line() +
      geom_segment(aes(x = k[1], y = wss[1],
                       xend = max(k), yend = wss[which.max(k)]),
                   linetype = "dashed") +
      geom_point(aes(size = (d == max(d)), color = (d == max(d))),
                 show.legend = FALSE) +
      scale_size_manual(values = c(2,5)) +
      scale_color_manual(values = c("black", "red")) +
      labs(x = "Number of clusters",
           y = "Total within-cluster sum of squares",
           title = "Elbow plot for the fuzzy K-means method") +
      theme_bw()
  }
  else if (alg == "hclust") {
    for (i in 1:kmax) {
      set.seed(13)
      tmp <- hcut(x, i)
      wss[i] <- get_wss(dist(x), tmp$cluster)
    }
    tmp <- data.frame(k = 1:kmax, wss)
    max_k <- max(tmp$k)
    max_k_wss <- tmp$wss[which.max(tmp$k)]
    max_wss <- max(tmp$wss)
    max_wss_k <- tmp$k[which.max(tmp$wss)]
    max_df <- data.frame(x = c(max_wss_k, max_k), y = c(max_wss, max_k_wss))
    tmp_lm <- lm(max_df$y ~ max_df$x)
    d <- c()
    for(i in 1:kmax) {
      d <- c(d, abs(coef(tmp_lm)[2]*i - tmp$wss[i] + coef(tmp_lm)[1]) /
               sqrt(coef(tmp_lm)[2]^2 + 1^2))
    }
    tmp$d <- d
    ggplot(data = tmp, aes(k, wss)) +
      geom_line() +
      geom_segment(aes(x = k[1], y = wss[1],
                       xend = max(k), yend = wss[which.max(k)]),
                   linetype = "dashed") +
      geom_point(aes(size = (d == max(d)), color = (d == max(d))),
                 show.legend = FALSE) +
      scale_size_manual(values = c(2,5)) +
      scale_color_manual(values = c("black", "red")) +
      labs(x = "Number of clusters",
           y = "Total within-cluster sum of squares",
           title = "Elbow plot for the hierarchical method") +
      theme_bw()
  }
}

# Função vizualização dos grupos
# NÃO MUDAR!
cluster_viz <- function(data, clusters, 
                        axes = c(1, 2), geom = c("point", "text"), repel = TRUE, 
                        show.clust.cent = TRUE, ellipse = TRUE, ellipse.type = "convex", 
                        ellipse.level = 0.95, ellipse.alpha = 0.2, shape = NULL, 
                        pointsize = 1.5, labelsize = 12, main = "Cluster plot",
                        ggtheme = theme_bw()) {
  require(factoextra)
  data <- scale(data)
  pca <- stats::prcomp(data, scale = FALSE, center = FALSE)
  ind <- facto_summarize(pca, element = "ind", result = "coord", axes = axes)
  eig <- get_eigenvalue(pca)[axes, 2]
  xlab <- paste0("Dim", axes[1], " (", round(eig[1], 1), "%)")
  ylab <- paste0("Dim", axes[2], " (", round(eig[2], 1), "%)")
  colnames(ind)[2:3] <- c("x", "y")
  label_coord <- ind
  lab <- NULL
  if ("text" %in% geom) 
    lab <- "name"
  if (is.null(shape)) 
    shape <- "cluster"
  plot.data <- cbind.data.frame(ind, cluster = clusters, stringsAsFactors = TRUE)
  label_coord <- cbind.data.frame(label_coord, cluster = clusters, stringsAsFactors = TRUE)
  p <- ggpubr::ggscatter(plot.data, "x", "y", color = "cluster", 
                         shape = shape, size = pointsize, point = "point" %in% geom,
                         label = lab, font.label = labelsize, repel = repel, 
                         mean.point = show.clust.cent, ellipse = ellipse, ellipse.type = ellipse.type, 
                         ellipse.alpha = ellipse.alpha, ellipse.level = ellipse.level, 
                         main = main, xlab = xlab, ylab = ylab, ggtheme = ggtheme)
  p
}

# Encontrar número ótimo de grupos para o método hierárquico
set.seed(123456789)
p3 <- elbow.plot(dados.pad, alg = "hclust")
p3

# K "ótimo" é igual a 4. Mudar de acordo com o seu resultado

d <-dist(dados.pad, method = "euclidean")
h.fit <-hclust(d, method = "ward.D")
plot(h.fit, main='Dendograma - Método Hierárquico', xlab='Cluster das Observações - Distância Euclidiana e Método de Ward', ylab='Altura')

groups_a <- cutree(h.fit, k=3)
groups_a 

 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1 
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  2  1  2 
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 
 2  2  1  2  2  2  2  2  2  1  2  2  2  2  2  2  2  3  2  3  2  2  3  2  2  3 
79 80 81 82 83 84 85 
 3  2  2  2  2  2  2 

groups_b <- cutree(h.fit, k=4)
groups_b 

 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1 
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  2  1  3 
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 
 3  3  1  2  2  2  2  2  3  1  2  2  3  3  2  2  2  4  2  4  2  2  4  3  2  4 
79 80 81 82 83 84 85 
 4  2  2  2  2  2  2 

groups_c <- cutree(h.fit, k=5)
dendogram3 <- rect.hclust(h.fit, k=5, border="red")

dendogram3

[[1]]
 2  3  4  6  9 10 11 13 17 18 28 29 31 33 37 42 43 48 49 55 62 
 2  3  4  6  9 10 11 13 17 18 28 29 31 33 37 42 43 48 49 55 62 

[[2]]
 1  5  7  8 12 14 15 16 19 20 21 22 23 24 25 26 27 30 32 34 35 36 38 39 40 41 
 1  5  7  8 12 14 15 16 19 20 21 22 23 24 25 26 27 30 32 34 35 36 38 39 40 41 
44 45 46 47 51 
44 45 46 47 51 

[[3]]
70 72 75 78 79 
70 72 75 78 79 

[[4]]
52 53 54 61 65 66 76 
52 53 54 61 65 66 76 

[[5]]
50 56 57 58 59 60 63 64 67 68 69 71 73 74 77 80 81 82 83 84 85 
50 56 57 58 59 60 63 64 67 68 69 71 73 74 77 80 81 82 83 84 85 

summary(fatorial2$scores)

    Factor1           Factor2            Factor3           Factor4        
 Min.   :-1.1249   Min.   :-1.11082   Min.   :-3.1932   Min.   :-2.11638  
 1st Qu.:-0.6559   1st Qu.:-0.21990   1st Qu.:-0.2904   1st Qu.:-0.18303  
 Median :-0.3633   Median :-0.11821   Median :-0.1839   Median :-0.14019  
 Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.00000  
 3rd Qu.: 0.3353   3rd Qu.:-0.04689   3rd Qu.: 0.0107   3rd Qu.:-0.06075  
 Max.   : 3.3937   Max.   : 7.06890   Max.   : 6.5278   Max.   : 7.41904  

attach(dados)
by(dados, groups_c, summary)

groups_c: 1
       x1             x2              x3               x4       
 Min.   :29.0   Min.   :1.000   Min.   : 33000   Min.   : 6667  
 1st Qu.:49.0   1st Qu.:2.000   1st Qu.: 87150   1st Qu.:13345  
 Median :52.0   Median :3.000   Median :127400   Median :16667  
 Mean   :53.1   Mean   :2.903   Mean   :147082   Mean   :16839  
 3rd Qu.:60.0   3rd Qu.:3.000   3rd Qu.:166400   3rd Qu.:21027  
 Max.   :70.0   Max.   :5.000   Max.   :461700   Max.   :30000  
       x5              x6              x7              x8        
 Min.   :    0   Min.   : 1071   Min.   :12000   Min.   : 16660  
 1st Qu.:    0   1st Qu.: 1401   1st Qu.:18000   1st Qu.: 30268  
 Median :17376   Median : 1900   Median :19200   Median : 43008  
 Mean   :18577   Mean   : 3339   Mean   :20923   Mean   : 44942  
 3rd Qu.:26064   3rd Qu.: 3378   3rd Qu.:24000   3rd Qu.: 55152  
 Max.   :69504   Max.   :27480   Max.   :38400   Max.   :116484  
       x9             x10              x11               x12      
 Min.   :0.000   Min.   :0.0000   Min.   :0.00000   Min.   :10.0  
 1st Qu.:0.000   1st Qu.:0.1111   1st Qu.:0.00000   1st Qu.:20.0  
 Median :2.000   Median :0.1111   Median :0.00000   Median :20.0  
 Mean   :2.065   Mean   :0.1254   Mean   :0.03226   Mean   :22.9  
 3rd Qu.:3.000   3rd Qu.:0.1111   3rd Qu.:0.00000   3rd Qu.:25.0  
 Max.   :8.000   Max.   :0.2222   Max.   :0.14286   Max.   :50.0  
      x13             x15      
 Min.   :0.000   Min.   :0.03  
 1st Qu.:1.000   1st Qu.:0.06  
 Median :1.000   Median :0.12  
 Mean   :1.323   Mean   :0.12  
 3rd Qu.:2.000   3rd Qu.:0.17  
 Max.   :2.000   Max.   :0.30  
------------------------------------------------------------ 
groups_c: 2
       x1              x2              x3               x4       
 Min.   :50.00   Min.   :1.000   Min.   : 21250   Min.   : 3333  
 1st Qu.:61.00   1st Qu.:2.000   1st Qu.: 49200   1st Qu.:13333  
 Median :65.00   Median :2.000   Median : 86100   Median :16429  
 Mean   :65.95   Mean   :2.095   Mean   : 91014   Mean   :17585  
 3rd Qu.:71.00   3rd Qu.:2.000   3rd Qu.:126000   3rd Qu.:21000  
 Max.   :78.00   Max.   :3.000   Max.   :160402   Max.   :31000  
       x5              x6              x7              x8       
 Min.   :    0   Min.   :  880   Min.   : 9240   Min.   :12870  
 1st Qu.:    0   1st Qu.: 1650   1st Qu.:16800   1st Qu.:23410  
 Median :    0   Median : 2003   Median :20400   Median :26080  
 Mean   : 8834   Mean   : 3469   Mean   :19069   Mean   :33256  
 3rd Qu.:17376   3rd Qu.: 3000   3rd Qu.:21600   3rd Qu.:38000  
 Max.   :34752   Max.   :25300   Max.   :26400   Max.   :62740  
       x9              x10              x11               x12        
 Min.   :0.0000   Min.   :0.0000   Min.   :0.00000   Min.   : 0.000  
 1st Qu.:0.0000   1st Qu.:0.1111   1st Qu.:0.00000   1st Qu.: 5.000  
 Median :0.0000   Median :0.1111   Median :0.00000   Median :10.000  
 Mean   :0.9524   Mean   :0.1058   Mean   :0.03401   Mean   : 8.619  
 3rd Qu.:2.0000   3rd Qu.:0.1111   3rd Qu.:0.00000   3rd Qu.:10.000  
 Max.   :4.0000   Max.   :0.2222   Max.   :0.14286   Max.   :20.000  
      x13             x15       
 Min.   :0.000   Min.   :0.060  
 1st Qu.:1.000   1st Qu.:0.120  
 Median :1.000   Median :0.120  
 Mean   :1.286   Mean   :0.149  
 3rd Qu.:2.000   3rd Qu.:0.160  
 Max.   :2.000   Max.   :0.460  
------------------------------------------------------------ 
groups_c: 3
       x1              x2              x3                x4       
 Min.   :26.00   Min.   :1.000   Min.   : 105000   Min.   :11284  
 1st Qu.:35.00   1st Qu.:5.000   1st Qu.: 208000   1st Qu.:22381  
 Median :42.00   Median :5.000   Median : 403580   Median :30000  
 Mean   :43.24   Mean   :4.952   Mean   : 567728   Mean   :30888  
 3rd Qu.:51.00   3rd Qu.:6.000   3rd Qu.: 720000   3rd Qu.:34714  
 Max.   :65.00   Max.   :8.000   Max.   :2380000   Max.   :62963  
       x5               x6               x7              x8        
 Min.   : 10080   Min.   :  1350   Min.   : 3720   Min.   : 51280  
 1st Qu.: 42000   1st Qu.: 55000   1st Qu.:12360   1st Qu.:148600  
 Median : 83040   Median :145000   Median :15840   Median :309824  
 Mean   :117334   Mean   :146283   Mean   :20742   Mean   :306951  
 3rd Qu.:167202   3rd Qu.:220000   3rd Qu.:25800   3rd Qu.:420600  
 Max.   :312000   Max.   :350000   Max.   :51600   Max.   :608400  
       x9              x10              x11              x12        
 Min.   : 0.000   Min.   :0.0000   Min.   :0.0000   Min.   : 0.000  
 1st Qu.: 4.000   1st Qu.:0.2222   1st Qu.:0.0000   1st Qu.: 0.000  
 Median : 8.000   Median :0.3333   Median :0.1429   Median : 5.000  
 Mean   : 9.238   Mean   :0.2910   Mean   :0.1463   Mean   : 5.048  
 3rd Qu.:13.000   3rd Qu.:0.4444   3rd Qu.:0.2857   3rd Qu.:10.000  
 Max.   :25.000   Max.   :0.5556   Max.   :0.4286   Max.   :10.000  
      x13             x15        
 Min.   :1.000   Min.   :0.0000  
 1st Qu.:3.000   1st Qu.:0.4700  
 Median :4.000   Median :0.5900  
 Mean   :3.571   Mean   :0.5671  
 3rd Qu.:4.000   3rd Qu.:0.7100  
 Max.   :6.000   Max.   :0.8900  
------------------------------------------------------------ 
groups_c: 4
       x1              x2              x3                x4       
 Min.   :39.00   Min.   :3.000   Min.   : 176000   Min.   : 8000  
 1st Qu.:49.50   1st Qu.:6.000   1st Qu.: 714000   1st Qu.:13583  
 Median :52.00   Median :7.000   Median :1015000   Median :19444  
 Mean   :52.43   Mean   :6.143   Mean   :1017429   Mean   :19537  
 3rd Qu.:57.00   3rd Qu.:7.000   3rd Qu.:1446500   3rd Qu.:20800  
 Max.   :63.00   Max.   :7.000   Max.   :1610000   Max.   :40545  
       x5               x6               x7              x8        
 Min.   : 24000   Min.   : 49000   Min.   :15240   Min.   :101280  
 1st Qu.:125544   1st Qu.:134150   1st Qu.:28380   1st Qu.:472710  
 Median :242448   Median :235000   Median :37200   Median :605008  
 Mean   :223483   Mean   :244614   Mean   :44286   Mean   :588103  
 3rd Qu.:279696   3rd Qu.:330000   3rd Qu.:59400   3rd Qu.:739880  
 Max.   :487452   Max.   :500000   Max.   :82000   Max.   :985252  
       x9             x10              x11              x12       
 Min.   : 0.00   Min.   :0.5556   Min.   :0.4286   Min.   : 1.00  
 1st Qu.: 8.50   1st Qu.:0.5556   1st Qu.:0.5000   1st Qu.: 6.50  
 Median :22.00   Median :0.5556   Median :0.6429   Median :10.00  
 Mean   :20.14   Mean   :0.6508   Mean   :0.5918   Mean   :11.71  
 3rd Qu.:28.50   3rd Qu.:0.7222   3rd Qu.:0.6786   3rd Qu.:15.00  
 Max.   :45.00   Max.   :0.8889   Max.   :0.7143   Max.   :28.00  
      x13              x15        
 Min.   : 5.000   Min.   :0.6700  
 1st Qu.: 6.000   1st Qu.:0.7800  
 Median : 6.000   Median :0.8800  
 Mean   : 7.286   Mean   :0.8629  
 3rd Qu.: 7.500   3rd Qu.:0.9650  
 Max.   :13.000   Max.   :1.0000  
------------------------------------------------------------ 
groups_c: 5
       x1             x2            x3                x4       
 Min.   :27.0   Min.   :7.0   Min.   :4290000   Min.   :18033  
 1st Qu.:29.0   1st Qu.:7.0   1st Qu.:4375000   1st Qu.:25000  
 Median :29.0   Median :7.0   Median :6160000   Median :34310  
 Mean   :35.4   Mean   :7.4   Mean   :5616500   Mean   :29814  
 3rd Qu.:40.0   3rd Qu.:8.0   3rd Qu.:6237500   3rd Qu.:35227  
 Max.   :52.0   Max.   :8.0   Max.   :7020000   Max.   :36500  
       x5                x6                x7               x8         
 Min.   : 391680   Min.   : 553000   Min.   :     0   Min.   :1829004  
 1st Qu.: 456840   1st Qu.:1200000   1st Qu.: 60000   1st Qu.:1855840  
 Median : 920004   Median :1300000   Median : 60000   Median :2747440  
 Mean   : 809705   Mean   :1730600   Mean   :105600   Mean   :2991657  
 3rd Qu.:1080000   3rd Qu.:1900000   3rd Qu.:144000   3rd Qu.:3376000  
 Max.   :1200000   Max.   :3700000   Max.   :264000   Max.   :5150000  
       x9            x10              x11              x12          x13      
 Min.   : 0.0   Min.   :0.4444   Min.   :0.2143   Min.   : 0   Min.   : 3.0  
 1st Qu.:30.0   1st Qu.:0.7778   1st Qu.:0.4286   1st Qu.: 5   1st Qu.: 6.0  
 Median :44.0   Median :0.7778   Median :0.7143   Median : 5   Median : 8.0  
 Mean   :50.8   Mean   :0.7556   Mean   :0.6143   Mean   : 8   Mean   : 7.4  
 3rd Qu.:90.0   3rd Qu.:0.7778   3rd Qu.:0.8571   3rd Qu.:10   3rd Qu.: 8.0  
 Max.   :90.0   Max.   :1.0000   Max.   :0.8571   Max.   :20   Max.   :12.0  
      x15       
 Min.   :0.460  
 1st Qu.:0.760  
 Median :0.810  
 Mean   :0.762  
 3rd Qu.:0.860  
 Max.   :0.920  

# Agrupamento usando o método hierárquico - 2 forma
nclust = 5 # Número de grupos de acordo com os gráficos
fit.hclust <- hcut(dados.pad, 5) # Ajustar K de acordo com o gráfico
fit.hclust

Call:
stats::hclust(d = x, method = hc_method)

Cluster method   : ward.D2 
Distance         : euclidean 
Number of objects: 85 

g_cluster <- cluster_viz(dados.pad, as.factor(fit.hclust$cluster), geom = "point", main = "Gráfico Cluster para o Método Hierárquico")
plot(g_cluster)

Métodos Não-Hierárquicos

São métodos de partição de “n” objetos em “k” grupos. Os “k” grupos são pré-determinados. A cada passo verifica-se se os objetos estão alocados da “melhor” maneira. Função objetivo: procura minimizar a variância dentro do grupo e maximizar a variância entre os grupos.

Não fornece dendograma. Isto porque se em algum passo do algoritmo dois elementos tiverem sido colocados num mesmo cluster, não necessariamente “estarão juntos” na partição final. Bom quando se tem um grande número de observações. O problema principal aqui não é o número de grupos e sim a melhor forma de alocar os elementos em k grupos. O método mais usado é o das k-médias (k-means).

Resumidamente, o método das k-means é composto de quatro passos. No primeiro são selecionados k centróides para inicializar o processo de partição. Cada elemento do conjunto de dados é, então, comparado com cada centróide inicial, através de uma medida de distância que, em geral, é a Euclidiana. O elemento é alocado ao grupo cuja distância é a menor. No terceiro passo, recalcula-se os valores dos centróides para cada novo grupo formado. Com estes novos centróides, repete-se o passo 2. Isto deve ser repetido até que nenhuma realocação de elementos seja necessária.

cluster_kmeans <- elbow.plot(dados.pad)
cluster_kmeans

kmeans1 <- kmeans(dados.pad, centers=5)
#Centróides
kmeans1$centers

           x1         x2           x3         x4         x5          x6
1 -1.34515006  1.8072111  3.701528552  0.8027013  3.2778778  3.23549118
2 -0.02424868  1.1862676  0.287208385 -0.1871013  0.5550533  0.17399627
3 -0.02004540 -0.3831231 -0.355117495 -0.3418032 -0.3879402 -0.32287084
4 -0.79009568  0.6492143  0.007068955  1.1307878  0.1277874  0.01285434
5  0.83455884 -0.6890467 -0.397959050 -0.5056032 -0.4355642 -0.31782898
          x7          x8         x9        x10        x11        x12        x13
1  2.4501995  3.49247328  2.7059130  2.2639164  2.1490201 -0.5026098  1.8761180
2  0.5309120  0.34475417  0.7714212  1.8022454  2.0470493 -0.1411494  1.8303262
3 -0.1966927 -0.36414512 -0.3560014 -0.5085221 -0.5070145  1.0175370 -0.5500592
4 -0.1810064  0.02647696  0.1454207  0.2944307  0.1338101 -0.7891520  0.3802517
5 -0.2694298 -0.37661625 -0.4316555 -0.5572274 -0.4915234 -0.4539516 -0.5032957
         x15
1  1.4079157
2  1.7417060
3 -0.6848525
4  0.9214138
5 -0.6137018

#Plot dos Clusters
clusplot(dados.pad, kmeans1$cluster, main="2D Representação da solução dos Clusters",
         color=TRUE, shade=TRUE, labels=2, lines=0)

# Agrupamento usando o K-means - 2 forma
fit.kmeans <- kmeans(dados.pad, 5) # Ajustar K de acordo com o gráfico
fit.kmeans

K-means clustering with 5 clusters of sizes 18, 5, 29, 26, 7

Cluster means:
           x1         x2           x3         x4         x5          x6
1 -0.79009568  0.6492143  0.007068955  1.1307878  0.1277874  0.01285434
2 -1.34515006  1.8072111  3.701528552  0.8027013  3.2778778  3.23549118
3 -0.02004540 -0.3831231 -0.355117495 -0.3418032 -0.3879402 -0.32287084
4  0.83455884 -0.6890467 -0.397959050 -0.5056032 -0.4355642 -0.31782898
5 -0.02424868  1.1862676  0.287208385 -0.1871013  0.5550533  0.17399627
          x7          x8         x9        x10        x11        x12        x13
1 -0.1810064  0.02647696  0.1454207  0.2944307  0.1338101 -0.7891520  0.3802517
2  2.4501995  3.49247328  2.7059130  2.2639164  2.1490201 -0.5026098  1.8761180
3 -0.1966927 -0.36414512 -0.3560014 -0.5085221 -0.5070145  1.0175370 -0.5500592
4 -0.2694298 -0.37661625 -0.4316555 -0.5572274 -0.4915234 -0.4539516 -0.5032957
5  0.5309120  0.34475417  0.7714212  1.8022454  2.0470493 -0.1411494  1.8303262
         x15
1  0.9214138
2  1.4079157
3 -0.6848525
4 -0.6137018
5  1.7417060

Clustering vector:
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
 3  4  4  4  3  3  4  4  4  4  4  3  4  3  3  3  4  4  3  3  3  3  3  3  3  3 
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 
 3  4  4  4  4  3  4  3  3  3  4  3  3  3  4  4  4  3  3  3  3  4  4  3  3  5 
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 
 5  5  4  1  4  1  1  1  5  4  1  1  5  5  1  1  1  2  1  2  1  1  2  5  1  2 
79 80 81 82 83 84 85 
 2  1  4  1  1  1  1 

Within cluster sum of squares by cluster:
[1]  86.28616 143.25082  64.37370  48.86236  43.95670
 (between_SS / total_SS =  67.1 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"      

g_kmeans <- cluster_viz(dados.pad, as.factor(fit.kmeans$cluster), geom = "point",
                  main = "Gráfico Cluster para o Método K-médias")
plot(g_kmeans)